home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s1.arc / GETAREAC.MOD < prev    next >
Text File  |  1987-03-16  |  6KB  |  168 lines
  1. (*--------------------------------------------------------------------------*)
  2. (*            GetAreaCode --- Get area code for city/state/country          *)
  3. (*--------------------------------------------------------------------------*)
  4.  
  5. PROCEDURE GetAreaCode;
  6.  
  7. (*--------------------------------------------------------------------------*)
  8. (*                                                                          *)
  9. (*     Procedure:  GetAreaCode                                              *)
  10. (*                                                                          *)
  11. (*     Purpose:    Searches area code directory                             *)
  12. (*                                                                          *)
  13. (*     Calling sequence:                                                    *)
  14. (*                                                                          *)
  15. (*        GetAreaCode;                                                      *)
  16. (*                                                                          *)
  17. (*     Calls:                                                               *)
  18. (*                                                                          *)
  19. (*        UpperCase                                                         *)
  20. (*        Save_Screen                                                       *)
  21. (*        Draw_Menu_Frame                                                   *)
  22. (*        Restore_Screen                                                    *)
  23. (*        Reset_Global_Colors                                               *)
  24. (*                                                                          *)
  25. (*     Called by:  Execute_Command                                          *)
  26. (*                                                                          *)
  27. (*     Credit:  This area code search is based upon one by Tom Hanlin III   *)
  28. (*              in his ETERM and PASCTERM programs, and one by Martin Smith *)
  29. (*              in his AREA2.EXE program.                                   *)
  30. (*                                                                          *)
  31. (*--------------------------------------------------------------------------*)
  32.  
  33. CONST
  34.    MaxAreaCodes = 300;
  35.  
  36. VAR
  37.    LF             : BYTE;
  38.    RT             : BYTE;
  39.    Ptr            : BYTE;
  40.    I              : BYTE;
  41.    Code           : STRING[20];
  42.    Any_Ch         : CHAR;
  43.    AreaCode       : ARRAY[0..MaxAreaCodes] OF STRING[60];
  44.    AreaCodeFile   : TEXT[1024];
  45.    N_Area_Codes   : INTEGER;
  46.    Searching_Done : BOOLEAN;
  47.  
  48. (*--------------------------------------------------------------------------*)
  49.  
  50. PROCEDURE Do_Area_Code_Search;
  51.  
  52. BEGIN (* Searching_Done *)
  53.                                    (* Convert to upper case *)
  54.     Code := UpperCase( Code );
  55.  
  56.                                    (* Determine type of request *)
  57.     IF ( RT = 2 ) AND
  58.        ( Code[1] IN ['A'..'Z']) AND ( Code[2] IN ['A'..'Z'] ) THEN
  59.           LF := 4
  60.     ELSE IF ( RT = 3 ) AND
  61.        ( Code[1] IN ['0'..'9'] ) AND
  62.        ( Code[2] IN ['0'..'9'] ) AND
  63.        ( Code[3] IN ['0'..'9'] ) THEN
  64.           LF := 1
  65.     ELSE IF RT <> 0 THEN
  66.           LF := 6;
  67.                                    (* Display search message *)
  68.  
  69.     Draw_Menu_Frame( 5, 4, 75, 23, Menu_Frame_Color, Menu_Title_Color,
  70.                      Menu_Text_Color, 'Searching for: ' + Code );
  71.  
  72.                                    (* Perform search *)
  73.     View_Count := 0;
  74.     View_Done  := FALSE;
  75.  
  76.     FOR I := 0 TO N_Area_Codes DO
  77.        IF ( NOT View_Done ) THEN
  78.           IF UpperCase( Copy( AreaCode[I], LF, RT ) ) = Code THEN
  79.              BEGIN
  80.  
  81.                 WRITE  ( '     ' );
  82.                 WRITE  ( Copy( AreaCode[I], 1, 3 ), '   ' );
  83.                 WRITE  ( Copy( AreaCode[I], 4, 2 ) ,'   ' );
  84.                 WRITELN( Copy( AreaCode[I], 6, LENGTH( AreaCode[I] ) - 5 ) );
  85.  
  86.                 View_Count := View_Count + 1;
  87.  
  88.                 IF View_Count > 16 THEN
  89.                    View_Prompt( View_Done, View_Count );
  90.  
  91.              END;
  92.  
  93.     RvsVideoOn ( Menu_Text_Color , BLACK );
  94.     WRITE('Search complete. Hit any key to continue.');
  95.     RvsVideoOff( Menu_Text_Color , BLACK );
  96.  
  97.     Read_Kbd( Any_Ch );
  98.     IF ( Any_Ch = CHR( ESC ) ) AND KeyPressed THEN
  99.        READ( Kbd, Any_Ch );
  100.  
  101. END   (* Searching_Done *);
  102.  
  103. (*--------------------------------------------------------------------------*)
  104.  
  105. BEGIN (* GetAreaCode *)
  106.                                    (* Save current screen *)
  107.     Save_Screen( Saved_Screen );
  108.                                    (* Display area code prompt box *)
  109.  
  110.     Draw_Menu_Frame( 5, 4, 75, 23, Menu_Frame_Color, Menu_Title_Color,
  111.                      Menu_Text_Color, 'Area code search' );
  112.  
  113.                                    (* Open area code directory file *)
  114.  
  115.     ASSIGN( AreaCodeFile , Home_Dir + 'PIBTERM.ACO' );
  116.        (*$I-*)
  117.     RESET ( AreaCodeFile );
  118.        (*$I+*)
  119.                                    (* Check if open went OK *)
  120.     IF ( Int24Result <> 0 ) THEN
  121.        BEGIN
  122.           WRITELN('Area code file ', Home_Dir, ' PIBTERM.ACO cannot be opened.');
  123.           WRITELN;
  124.           DELAY( Two_Second_Delay );
  125.           Restore_Screen( Saved_Screen );
  126.           Reset_Global_Colors;
  127.           EXIT;
  128.        END;
  129.                                    (* Read in area code data *)
  130.  
  131.     WRITELN('Reading area code information ... ');
  132.  
  133.     N_Area_Codes := -1;
  134.  
  135.     REPEAT
  136.        N_Area_Codes := N_Area_Codes + 1;
  137.        READLN( AreaCodeFile , AreaCode[N_Area_Codes] );
  138.     UNTIL ( EOF( AreaCodeFile ) );
  139.  
  140.        (*$I-*)
  141.     CLOSE( AreaCodeFile );
  142.        (*$I+*)
  143.                                    (* Prompt for and read area code req. *)
  144.     Searching_Done := FALSE;
  145.  
  146.     REPEAT
  147.  
  148.        Clear_Window;
  149.  
  150.        WRITE('Enter area code, state/country, or state initials: ');
  151.        Code := '';
  152.        Read_Edited_String( Code );
  153.  
  154.        RT := LENGTH( Code );
  155.  
  156.        IF ( ( RT > 0 ) AND ( Code <> CHR( ESC ) ) ) THEN
  157.           Do_Area_Code_Search
  158.        ELSE
  159.           Searching_Done := TRUE;
  160.  
  161.     UNTIL( Searching_Done );
  162.                                    (* Restore previous screen *)
  163.    Restore_Screen( Saved_Screen );
  164.  
  165.    Reset_Global_Colors;
  166.  
  167. END   (* GetAreaCode *);
  168.